-----------------------------------------------------------------------------
-- |
-- Module      :  Core.Lang
-- Copyright   :  (c) Luigi D. C. Soares 2020
-- License     :  GPL-3
--
-- Maintainer  :  luigidcsoares@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module contains the definition of the language.
----------------------------------------------------------------------------
module Core.Lang
    ( Label
    , Const
    , Var
    , Value(..)
    , Expr(..)
    , Inst(..)
    , Stm
    , Prog
    , IVar(..)
    , isControl
    , labelFrom
    , showStm
    , showProg
    , prefix
    , next
    , defs
    )
where

import           Prelude                 hiding ( and )
import           Data.List                      ( transpose )

type Label = String
type Const = Integer
type Var = String

data Value = Const Const | Var Var deriving (Eq, Ord)
instance Show Value where
    show (Const n) = show n
    show (Var   x) = x

data Expr = Value Value
          | Neg Value
          | Not Value
          | BitNot Value
          | Value :+: Value
          | Value :-: Value
          | Value :*: Value
          | Value :&: Value
          | Value :|: Value
          | Value :>>: Value
          | Value :<<: Value
          | Value :=: Value
          | Value :!=: Value
          | Value :<: Value
          | Value :>: Value
          | Value :<=: Value
          | Value :>=: Value
          deriving (Eq, Ord)

instance Show Expr where
    show (Value  v  ) = show v
    show (Neg    v  ) = "-" ++ show v
    show (Not    v  ) = "!" ++ show v
    show (BitNot v  ) = "~" ++ show v
    show (v1 :+:  v2) = show v1 ++ " + " ++ show v2
    show (v1 :-:  v2) = show v1 ++ " - " ++ show v2
    show (v1 :*:  v2) = show v1 ++ " * " ++ show v2
    show (v1 :&:  v2) = show v1 ++ " & " ++ show v2
    show (v1 :|:  v2) = show v1 ++ " | " ++ show v2
    show (v1 :>>: v2) = show v1 ++ " >> " ++ show v2
    show (v1 :<<: v2) = show v1 ++ " << " ++ show v2
    show (v1 :=:  v2) = show v1 ++ " = " ++ show v2
    show (v1 :!=: v2) = show v1 ++ " != " ++ show v2
    show (v1 :<:  v2) = show v1 ++ " < " ++ show v2
    show (v1 :>:  v2) = show v1 ++ " > " ++ show v2
    show (v1 :<=: v2) = show v1 ++ " <= " ++ show v2
    show (v1 :>=: v2) = show v1 ++ " >= " ++ show v2

data Inst = Alloc Var Expr
          | Mov Var Expr
          | Load Var Var Value
          | Store Value Var Value
          | Phi  Var [(Label, Value)]
          | Jmp  Label
          | Br  Value Label Label
          | Out Expr
          deriving (Eq, Ord)

instance Show Inst where
    show (Alloc x e   ) = "alloc(" ++ x ++ ", " ++ show e ++ ")"
    show (Mov   x e   ) = "mov(" ++ x ++ ", " ++ show e ++ ")"
    show (Load x m idx) = "load(" ++ x ++ ", " ++ m ++ ", " ++ show idx ++ ")"
    show (Store v m idx) =
        "store(" ++ show v ++ ", " ++ m ++ ", " ++ show idx ++ ")"
    show (Phi x selectors) =
        "phi(" ++ x ++ ", " ++ showSelectors selectors ++ ")"
      where
        showSelectors :: [(Label, Value)] -> String
        showSelectors [(l, v)] = show v ++ ": " ++ l
        showSelectors ((l, v) : selectors) =
            show v ++ ": " ++ l ++ ", " ++ showSelectors selectors
    show (Jmp l     ) = "jmp(" ++ l ++ ")"
    show (Br e l1 l2) = "br(" ++ show e ++ ", " ++ l1 ++ ", " ++ l2 ++ ")"
    show (Out e     ) = "out(" ++ show e ++ ")"

type Stm = (Maybe Label, Inst)
type Prog = [Stm]

-- | Implicit var, generated by the interpreter.
newtype IVar = IVar Int deriving Eq
instance Show IVar where
    show (IVar n) = prefix ++ show n

isControl :: Inst -> Bool
isControl i@Jmp{} = True
isControl i@Br{}  = True
isControl _       = False

labelFrom :: [Inst] -> [Label]
labelFrom []                  = []
labelFrom ((Jmp l     ) : is) = l : labelFrom is
labelFrom ((Br _ l1 l2) : is) = l1 : l2 : labelFrom is
labelFrom (_            : is) = labelFrom is

showStm :: Stm -> String
showStm (Nothing, i) = show i ++ "\n"
showStm (Just l , i) = l ++ ": " ++ show i ++ "\n"

showProg :: Prog -> String
showProg = concatMap showStm

-- | Prefix added to labels/vars generated by the interpreter.
prefix :: String
prefix = "%"

next :: IVar -> IVar
next (IVar t) = IVar $ t + 1

-- | The set of variables defined by a list of instructions.
defs :: [Inst] -> [Value]
defs []                 = []
defs (Alloc id _  : is) = Var id : defs is
defs (Mov   id _  : is) = Var id : defs is
defs (Load id _ _ : is) = Var id : defs is
defs (Phi id _    : is) = Var id : defs is
defs (_           : is) = defs is
